\ memory.utf .. external memory allocation system calls
\ Copyright (c)1994 Jack J. Woehr
\ P.O. Box 51, Golden, Colorado 80402-0051
\ jax@well.sf.ca.us 72203.1320@compuserve.com
\ SYSOP RCFB (303) 278-0364 2400/9600/14400
\ All Rights Reserved
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\ This is free software and can be modified and redistributed under
\ certain conditions described in the file COPYING.TXT. The
\ Disclaimer of Warranty and License for this free software are also
\ contained in the file COPYING.TXT.
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

\
\ $Revision: 1.3 $
\

MARKER memory.utf

\ ~~~~~~~~~~~~~~~~~~~~
\ Conditional INCLUDED
\ ~~~~~~~~~~~~~~~~~~~~

: PROVIDES ( c-addr u "ccc< >" --)
    BL WORD FIND NIP 0=
    IF INCLUDED ELSE 2DROP THEN ;

S" UTILS\UTILS.UTF" PROVIDES USEFUL
S" UTILS\SYSCALLS.UTF" PROVIDES LIBRARY

CR .( Loading Memory Allocation words) CR

USEFUL DECIMAL
SYSTEM-WORDLIST SET-CURRENT

\ System Calls
S" GlobalAlloc" KERNEL32 SYSTEMCALL GLOBALALLOC
S" GlobalReAlloc" KERNEL32 SYSTEMCALL GLOBALREALLOC
S" GlobalFree" KERNEL32 SYSTEMCALL GLOBALFREE
S" GetLastError" KERNEL32 SYSTEMCALL GETLASTERROR

\ Forth ALLOCATE defined in terms of above.
\ Remeber to OPEN-ALL and RESOLVE-ALL before using.
: ALLOCATE ( u -- a-addr ior)
    0 GLOBALALLOC NIP ( discard second return) DUP 0=
    IF GETLASTERROR NIP ( ditto) DUP LastError !
    ELSE ABSTODATA FALSE
    THEN
;

\ Forth FREE defined in terms of above.
\ Remeber to OPEN-ALL and RESOLVE-ALL before using.
: FREE ( a-addr -- ior)
    DATATOABS GLOBALFREE NIP
    IF GETLASTERROR NIP DUP LastError !
    ELSE FALSE
    THEN
;

\ Forth RESIZE defined in terms of above.
\ Remeber to OPEN-ALL and RESOLVE-ALL before using.
: RESIZE ( a-addr1 u -- a-addr2 ior)
    SWAP 0 ROT ROT DATATOABS  \ -- 0 u abs-addr
    GLOBALREALLOC NIP ( discard second return) DUP 0=
    IF GETLASTERROR NIP ( ditto) DUP LastError !
    ELSE ABSTODATA FALSE
    THEN
;

USEFUL

\ ~~~~~~~~~~~~~~~~~
\ End of memory.utf
\ ~~~~~~~~~~~~~~~~~